home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / NLMAN.PAS < prev    next >
Pascal/Delphi Source File  |  1997-03-02  |  14KB  |  430 lines
  1. UNIT NlMan;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ Nodelist Manager                              Last changed: 02.03.97  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-97 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32;
  16.  
  17. PROCEDURE NodeListManager;
  18.  
  19. IMPLEMENTATION
  20.  
  21. USES OpCrt, OpString, OpWindow, OpEdit, OpEntry, OpCmd, OpField, OpFrame,
  22.      OpMenu, OpKey, OpSelect, OpRoot,
  23.      Globals, NodeList, Display, Input, KeyBoard, MailUtil, OproUtil, InterCom,
  24.      Util, Resource, PoPTypes;
  25.  
  26.   PROCEDURE ShowFlags(ASP: AbstractSelectorPtr); far;
  27.   VAR
  28.     s : STRING;
  29.   BEGIN
  30.     WITH nodelistentry DO
  31.     BEGIN
  32.       IF Flags AND 1<>0 THEN s:='Hub ' ELSE s:='';
  33.       IF Flags AND 2<>0 THEN s:=s+'Host ';
  34.       IF Flags AND 4<>0 THEN s:=s+'RC ';
  35.       IF Flags AND 8<>0 THEN s:=s+'Zone Gate ';
  36.       IF Flags AND 16<>0 THEN s:=s+'Crash ';
  37.     END;
  38.     FastWrite(Pad(s,30),18,19,Cfg.Color[2].FieldColor);
  39.   END;
  40.  
  41.   PROCEDURE NodeListManager;
  42.   VAR
  43.     Adr         : TFidoAddress;
  44.     ExitCommand : WORD;
  45.     m           : TPoPMenu;
  46.     oldnl       : NodeListRecType;
  47.     esr         : TPoPEntryScreen;
  48.     FuncKeyWin  : windowptr;
  49.  
  50.     FUNCTION nodechanged : Boolean;
  51.     VAR
  52.       b : Boolean;
  53.       i : Integer;
  54.       o : ARRAY[1..1000] OF Char ABSOLUTE oldnl;
  55.       n : ARRAY[1..1000] OF Char ABSOLUTE nodelistentry;
  56.     BEGIN
  57.       b:=False;
  58.       i:=0;
  59.       REPEAT
  60.         Inc(i);
  61.         b:=(o[i]<>n[i]);
  62.       UNTIL b OR (i=SizeOf(NodeListRecType));
  63.       nodechanged:=b;
  64.     END;
  65.  
  66.     PROCEDURE checkedit;
  67.     BEGIN
  68.       IF nodechanged THEN
  69.       BEGIN
  70.         IF Confirm('Changes not saved, save >','Y',8) THEN
  71.           WriteNode(nodelistentry);
  72.       END;
  73.     END;
  74.  
  75.     PROCEDURE DeleteNode;
  76.     VAR
  77.       WaitWin : PWait;
  78.       i:LONGINT;
  79.       buf:ARRAY[1..10240] OF CHAR;
  80.       oldnp,test,ps:INTEGER;
  81.       f:FILE;
  82.       EndFlag:BOOLEAN;
  83.     BEGIN
  84.       IF Confirm('Delete current node','N',8) THEN
  85.       BEGIN
  86.         New(WaitWin, Init(9, 2, 'Deleting current node'));
  87.         CASE Cfg.NodeListTyp OF
  88.           NewNodeListType : BEGIN
  89.             ASSIGN(f,Cfg.NodeList+'NODELIST.DAT'); FileMode:=ShareRW+ShareDenyW;
  90.             RESET(f,SizeOf(NewNodeList));
  91.             ps:=SizeOf(NewNodeList);
  92.           END;
  93.         END;
  94.         EndFlag:=FALSE;
  95.         OldNP:=NodePos;
  96.         SEEK(f,NodePos+1);
  97.         WHILE NOT EndFlag DO
  98.         BEGIN
  99.           i:=FilePos(f);
  100.           BLOCKREAD(f,buf,10240 DIV ps,test);
  101.           EndFlag:=EOF(f);
  102.           SEEK(f,i-1);
  103.           BLOCKWRITE(f,buf,test);
  104.           WaitWin^.Animate;
  105.         END;
  106.         SEEK(f,FILESIZE(f)-1);TRUNCATE(f);
  107.         CLOSE(f);
  108.         CASE Cfg.NodeListTyp OF
  109.           NewNodeListType : BEGIN
  110.             ASSIGN(f,Cfg.NodeList+'NODELIST.IDX'); FileMode:=ShareRW+ShareDenyW;
  111.             RESET(f,SizeOf(NewNodeListIndex));
  112.             ps:=SizeOf(NewNodeListIndex);
  113.           END;
  114.         END;
  115.         SEEK(f,NodePos+1);
  116.         EndFlag:=FALSE;
  117.         WHILE NOT EndFlag DO
  118.         BEGIN
  119.           i:=FilePos(f);
  120.           BLOCKREAD(f,buf,10240 DIV ps,test);
  121.           EndFlag:=EOF(f);
  122.           SEEK(f,i-1);
  123.           BLOCKWRITE(f,buf,test);
  124.           WaitWin^.Animate;
  125.         END;
  126.         SEEK(f,FILESIZE(f)-1);TRUNCATE(f);
  127.         CLOSE(f);
  128.         DeAllocateNodeListIndex;
  129.         InitialiseNodeList(Cfg.NodeList,Cfg.NodeListTyp);
  130.         NodePos:=OldNP;
  131.         IF NOT FindPreviousNode(NodeListEntry) THEN
  132.           FindNextNode(NodeListEntry);
  133.         oldnl:=NodeListEntry;
  134.         Dispose(WaitWin, Done);
  135.         Esr.Draw;
  136.       END;
  137.     END;
  138.  
  139.     PROCEDURE CreateNode;
  140.     TYPE
  141.       BufType=ARRAY[1..2048] OF CHAR;
  142.     VAR
  143.       i,j     : Integer;
  144.       LastCmd,
  145.       key     : Word;
  146.       nodf    : FILE;
  147.       buf     : ^BufType;
  148.       WaitWin : PWait;
  149.     BEGIN
  150.       GetMenu(MnuNLInsNode,3,m);
  151.       m.ProcessMenu(Key, LastCmd);
  152.       IF LastCmd<>ccQuit THEN
  153.       BEGIN
  154.         New(Buf);
  155.         New(WaitWin, Init(8, 3, 'Making room for nodelist entry'));
  156.         IF Key=1 THEN j:=0 ELSE j:=1;
  157.         CASE Cfg.NodeListTyp OF
  158.           NewNodeListType : BEGIN
  159.             ASSIGN(nodf,Cfg.NodeList+'NODELIST.DAT'); FileMode:=ShareRW+ShareDenyW;
  160.             RESET(nodf,SizeOf(NewNodeList));
  161.           END;
  162.         END;
  163.         FOR i:=FileSize(nodf)-1 DOWNTO NodePos+j DO
  164.         BEGIN
  165.           Seek(nodf,i);
  166.           BLOCKREAD(nodf,buf^,1);
  167.           BLOCKWRITE(nodf,buf^,1);
  168.           WaitWin^.Animate;
  169.         END;
  170.         CLOSE(nodf);
  171.         WRITELN;
  172.         CASE Cfg.NodeListTyp OF
  173.           NewNodeListType : BEGIN
  174.             ASSIGN(nodf,Cfg.NodeList+'NODELIST.IDX'); FileMode:=ShareRW+ShareDenyW;
  175.             RESET(nodf,SizeOf(NewNodeListIndex));
  176.           END;
  177.         END;
  178.         FOR i:=FileSize(nodf)-1 DOWNTO NodePos+j DO
  179.         BEGIN
  180.           Seek(nodf,i);
  181.           BLOCKREAD(nodf,buf^,1);
  182.           BLOCKWRITE(nodf,buf^,1);
  183.           WaitWin^.Animate;
  184.         END;
  185.         CLOSE(nodf);
  186.         IF j=1 THEN INC(NodePos);
  187.         Dispose(Buf);
  188.         FillChar(NodeListEntry,SizeOf(NodeListEntry),0);
  189.         DeAllocateNodeListIndex;
  190.         InitialiseNodeList(Cfg.NodeList,Cfg.NodeListTyp);
  191.         Dispose(WaitWin, Done);
  192.       END;
  193.     END;
  194.  
  195.     PROCEDURE Search_Node;
  196.     VAR
  197.       SearchAdr : TFidoAddress;
  198.       ExitCommand     : WORD;
  199.       i : Integer;
  200.  
  201.       PROCEDURE InitMenu;
  202.       BEGIN
  203.         GetMenu(MNUNlSearchOpt,3,m);
  204.         IF NOT (NOT Cfg.NLCompiler.UseFidoUserLst) AND
  205.                (Cfg.NodeListTyp=NewNodeListType) THEN m.protectitem(4);
  206.         IF Cfg.NodelistTyp=Version7 THEN
  207.         BEGIN
  208.           m.protectItem(2);
  209.           m.protectItem(3);
  210.           m.protectItem(4);
  211.         END;
  212.       END;
  213.  
  214.       PROCEDURE search_for_node(CONST title: s40);
  215.       LABEL
  216.         SearchForSysOp;
  217.       VAR
  218.         f : TBufTextFile;
  219.         Break, Found : Boolean;
  220.         temp2 : WindowPtr;
  221.         WaitWin : PWait;
  222.         ss : STRING;
  223.         s : S40;
  224.  
  225.         PROCEDURE showwait;
  226.         BEGIN
  227.           New(WaitWin, Init(10, 4, 'Searching. Hit ESC to interrupt'));
  228.         END;
  229.  
  230.       BEGIN
  231.         s:='';
  232.         IF InputString(18,8,30,30,3,'Search by '+title,title+' : ',s) THEN
  233.         BEGIN
  234.           showwait;
  235.           Found:=False;
  236.           s:=StUpCase(s);
  237.           IF StUpCase(title)<>'SYSOP NAME' THEN
  238.           BEGIN
  239. SearchForSysOp:
  240.             FindFirstNode(nodelistentry);
  241.             REPEAT
  242.               Break:=GotESC;
  243.               IF Pos(s, StUpCase(nodelistentry.SysOpName)) > 0 THEN
  244.               BEGIN
  245.                 oldnl:=nodelistentry;
  246.                 Dispose(WaitWin, Done);
  247.                 esr.Draw;
  248.                 Found:=NOT Confirm('Data found. Search for more','Y',10);
  249.                 ShowWait;
  250.               END;
  251.               WaitWin^.Animate;
  252.             UNTIL Break OR Found OR NOT FindNextNode(nodelistentry);
  253.           END ELSE
  254.           BEGIN
  255.             IF Cfg.NodeListTyp=NewNodeListType THEN
  256.             BEGIN
  257.               s:=StUpCase(s);
  258.               Break:=False;
  259.               IF f.Init(Cfg.NodeList+'FIDOUSER.LST', SOpenRead, Max64k(MaxAvail-1024)) THEN
  260.               BEGIN
  261.                 WHILE NOT f.EoF AND NOT Break AND NOT Found DO
  262.                 BEGIN
  263.                   f.ReadLn(ss);
  264.                   Break:=GotESC;
  265.                   IF POS(s,StUpCase(ss))>0 THEN
  266.                   BEGIN
  267.                     Dispose(WaitWin, Done);
  268.                     MyWin(Temp2,3,5,77,7,3,'SysOp name',True);
  269.                     Temp2^.wFastText(ss,1,1);
  270.                     Found:=NOT Confirm('Data found. Search for more','Y',10);
  271.                     KillWindow(Temp2);
  272.                     ShowWait;
  273.                   END;
  274.                   WaitWin^.Animate;
  275.                 END;
  276.                 f.Done;
  277.               END;
  278.             END ELSE
  279.             BEGIN
  280.               GOTO SearchForSysOp;
  281.             END;
  282.           END;
  283.           Dispose(WaitWin, Done);
  284.           IF NOT ((StUpCase(title)='SYSOP NAME') AND
  285.                   (Cfg.NodeListTyp=NewNodeListType)) THEN
  286.           BEGIN
  287.             IF NOT Found OR Break THEN
  288.             BEGIN
  289.               Call.Zone:=OldNl.Adr.Zone;
  290.               Call.Net:=OldNl.Adr.Net;
  291.               Call.Node:=OldNl.Adr.Node;
  292.               Call.Point:=OldNl.Adr.Point;
  293.               IF FindNode(Call,nodelistentry) THEN
  294.               BEGIN
  295.                 esr.Draw;
  296.                 oldnl:=nodelistentry;
  297.               END;
  298.             END;
  299.           END ELSE
  300.           BEGIN
  301.             IF Found THEN
  302.             BEGIN
  303.               i:=60;
  304.               WHILE ss[i]<>' ' DO
  305.                 DEC(i);
  306.               s:=COPY(ss,i+1,60);
  307.               IF GetAdressFromStr(s,Call) AND FindNode(Call,NodelistEntry) THEN
  308.               BEGIN
  309.                 esr.Draw;
  310.                 oldnl:=nodelistentry;
  311.               END;
  312.             END;
  313.           END;
  314.         END;
  315.       END;
  316.  
  317.     BEGIN
  318.       checkedit;
  319.       InitMenu;
  320.       m.Process;
  321.       i:=m.MenuChoice;
  322.       m.Erase;
  323.       IF m.GetLastCommand<>ccQuit THEN
  324.       BEGIN
  325.         CASE i OF
  326.           1 : BEGIN               (* address *)
  327.                 FillChar(SearchAdr, SizeOf(SearchAdr), 0);
  328.                 SearchAdr.Zone:=NodeListEntry.Adr.Zone;
  329.                 SearchAdr.Net:=NodeListEntry.Adr.Net;
  330.                 IF GetAddress(6,3,SearchAdr,1501) THEN
  331.                 BEGIN
  332.                   IF FindNode(SearchAdr,nodelistentry) THEN oldnl:=nodelistentry ELSE
  333.                   BEGIN
  334.                     SearchAdr:=OldNl.Adr;
  335.                     FindNode(SearchAdr,nodelistentry);
  336.                   END;
  337.                   ESR.draw;
  338.                 END;
  339.               END;
  340.           2 : search_for_node('System name');
  341.           3 : search_for_node('Misc. info');
  342.           4 : search_for_node('SysOp name');
  343.         END;
  344.       END;
  345.       m.Done;
  346.     END;
  347.  
  348.   BEGIN
  349. {$IFNDEF PoPLite}
  350.     FillChar(Call, SizeOf(Call), 0);
  351.     IF Not SetInterCom(ICNLMan,Call,False) THEN Exit;
  352.     IF (NodeListPathStr<>'') OR (Cfg.NodelistTyp=Version7) THEN
  353.     BEGIN
  354.       MyWin(FuncKeyWin,1,ScreenHeight-1,80,ScreenHeight,2,'',False);
  355.       WITH Cfg.Color[2],FuncKeyWin^ DO
  356.       BEGIN
  357.         wFastWrite('                F2=Delete node  F3=Create new   F4=Save Node  F5=Search         ',1,1,HighLightColor);
  358.         wFastWrite('F6=Host         F7=RC           F8=Zone gate    F9=Hub        F10=Crash         ',2,1,HighLightColor);
  359.       END;
  360.       Adr:=Cfg.Addresses[Cfg.MainAdrNum];
  361.       IF FindNode(Adr,nodelistentry) THEN oldnl:=nodelistentry ELSE
  362.       BEGIN
  363.         Adr.Point:=0;
  364.         IF FindNode(Adr,nodelistentry) THEN oldnl:=nodelistentry ELSE
  365.           IF FindFirstNode(NodeListEntry) THEN oldnl:=nodelistentry;
  366.       END;
  367.       GetEsr(EsrNLManager,2,esr);
  368.       Esr.SetScreenUpdateProc(ShowFlags);
  369.       WITH esr,nodelistentry DO
  370.       BEGIN
  371.         EntryCommands.AddCommand(ccUser0,1,F10,0);
  372.         EntryCommands.AddCommand(ccNextRec,1,PgDn,0);
  373.         EntryCommands.AddCommand(ccPrevRec,1,PgUp,0);
  374.         FOR ExitCommand:=0 TO 7 DO
  375.           EntryCommands.addcommand(ccUser2+ExitCommand,1,WORD(256*(60+ExitCommand)),0);
  376.         exitcommand:=ccUser0;
  377.         Draw;
  378.         REPEAT
  379.           IF exitcommand IN [ccUser0,ccUser3..ccUser9,ccPrevRec,ccNextRec] THEN
  380.           BEGIN
  381.             TextAttr:=cfg.color[2].TextColor;
  382.           END;
  383.           Process;
  384.           exitcommand:=GetLastCommand;
  385.           CASE ExitCommand OF
  386.             ccUser2 : IF Cfg.NodeListTyp=NewNodeListType THEN DeleteNode;
  387.             ccUser3 : IF Cfg.NodeListTyp=NewNodeListType THEN CreateNode;
  388.             ccUser4 : IF Cfg.NodeListTyp=NewNodeListType THEN
  389.                       BEGIN
  390.                         IF WriteNode(nodelistentry) THEN oldnl:=nodelistentry;
  391.                       END;
  392.             ccUser5 : search_node;
  393.             ccUser6 : IF Cfg.NodeListTyp=NewNodeListType THEN Flags:=Flags XOR 2;
  394.             ccUser7 : IF Cfg.NodeListTyp=NewNodeListType THEN Flags:=Flags XOR 4;
  395.             ccUser8 : IF Cfg.NodeListTyp=NewNodeListType THEN Flags:=Flags XOR 8;
  396.             ccUser9 : IF Cfg.NodeListTyp=NewNodeListType THEN Flags:=Flags XOR 1;
  397.             ccUser0 : IF Cfg.NodeListTyp=NewNodeListType THEN Flags:=Flags XOR 16;
  398.             ccPrevRec : BEGIN
  399.                           IF Cfg.NodeListTyp=NewNodeListType THEN checkedit;
  400.                           IF NOT FindPreviousNode(nodelistentry) THEN
  401.                           BEGIN
  402.                             Write(#7);
  403.                             nodelistentry:=oldnl;
  404.                           END ELSE
  405.                             oldnl:=nodelistentry;
  406.                         END;
  407.             ccNextRec : BEGIN
  408.                           IF Cfg.NodeListTyp=NewNodeListType THEN checkedit;
  409.                           IF NOT FindNextNode(nodelistentry) THEN
  410.                           BEGIN
  411.                             Write(#7);
  412.                             nodelistentry:=oldnl;
  413.                           END ELSE
  414.                             oldnl:=nodelistentry;
  415.                         END;
  416.           END;
  417.           IF Cfg.NodeListTyp=NewNodeListType THEN
  418.             IF exitcommand IN [ccNextRec,ccPrevRec,ccquit] THEN checkedit;
  419.         UNTIL ExitCommand=ccquit;
  420.       END;
  421.       Esr.Done;
  422.       KillWindow(FuncKeyWin);
  423.       DeAllocateNodeListIndex;
  424.       InitialiseNodeList(Cfg.NodeList,Cfg.NodeListTyp);
  425.     END;
  426. {$ENDIF}
  427.   END;
  428.  
  429. END.
  430.